unit VerificacoesBanco;

interface

uses Classes, Registry, Windows, Dialogs, IniFiles, SysUtils, Forms, Controls,
FB_Consts,uConfig, uService, Messages, uDialogs, ShellAPI, FCC_Consts, uFileVersion;

resourcestring
  sRegistryEntryMissing = 'Firebird Registry Entries not found!'#13#10+
                          'Check if Firebird is installed!';
  sDirNotFound          = 'Path not found: ';
  sFileNotFound         = 'File not found: ';
  sRunningApp           = 'Running (Application)';
  sRunningSvc           = 'Running (Service)';
  sDisabled             = 'Disabled';
  sStopped              = 'Stopped';
  sStartPending         = 'Start pending';
  sStopPending          = 'Stop pending';
  sNotInstalled         = 'not installed';
  sStartServer          = 'Start';
  sStopServer           = 'Stop';
  sCancel               = '&Cancel';
  sClose                = '&Close';
  sAskStartServer       = 'Start Firebird server now?';
  sCouldNotLocateServer = 'Could not locate Firebird server';
  sSelectRootDir        = 'Select new Firebird root directory';
  sServiceAppsMissing   = 'instreg/instsvc or gds32.dll missing. Can''t change root directory.';
  sDLLIsLocked          = 'File is locked, can''t replace:'#13#10'%s'#13#10#13#10'Please close all applications and try again.';
  sConfirmChangeRoot    = 'Are you sure you want to change Firebird root directory'#13#10'to %s'#13#10'(Version %s) ?';

  sConfirmDeleteAlias   = 'Are you sure you want to delete this alias: %s ?';
  sConfirmDeleteTool    = 'Are you sure you want to delete this tool: %s ?';
  sDependentServices    = 'Info: There are %d dependent service(s)';
  sAskStopDependentServices = 'The following dependent services need to be stopped. Stop services now?'#13#10'%s';
  sAskStartDependentServices= 'Start the following dependent services now?'#13#10'%s';
  sErrCouldNotStopServer= 'Could not stop server.';
  sInvalidRootDir       = '%s is not a valid Firebird root directory';
  sCopyFailed           = 'Failed to copy %s';
  sAlias                = 'Alias';
  sPath                 = 'Path';
  
procedure AlterarArquivoServices;
procedure AlterarRegistroDoWindows;
procedure VerificarCaminhoDoBanco;
procedure PararServico;
procedure IniciarServico(UseServico, UseFBGuardias,UseAutoStart:boolean);
function IsServerRunning: Boolean;
function IsServerRunningSvc : Boolean;
function IsWinNT: Boolean;
procedure StopServer(Sender: TObject);
procedure StartServer(Sender: TObject);
function IsGuardRunning : Boolean;
function IsGuardRunningSvc : Boolean;
procedure ApplySettings(Sender : TObject;UseServico, UseFBGuardian, UseAutoStart : boolean);
procedure SetAppAutostart(const Name, Cmd, Params : string; const Value: Boolean; AllUsers: Boolean = true);
function IsAdmin: Boolean;
function GetFileVersion(const ExeFileName: String) : string;
function GetFirebirdRootDir : string;
function GetFirebirdVersion : string;

//procedure VerificarDlls;

implementation

uses Configuracoes;

var
  FBServerClass   : String;    // IB_Server
  FBServerName    : String;
  FBGuardClass    : String;
  FBGuardianName  : String;
  FBGuardExe      : String;
  FBServerExe     : String;
  GuardFound      : Boolean;
  FBBinDir        : string;
  FBRootDir       : string;
  ServerFound     : boolean;
  SL              : TServiceList;
  aName           : String;
  bEnabled        : boolean;
  bAutoStart      : boolean;
  bRunning        : boolean;
  FUseGuardian    : boolean;
  FUseService     : boolean;
  FUseAutoStart   : boolean;

procedure AlterarArquivoServices;
var
  ArquivoServices : TStrings;
  CamWindows      : String;
begin
  SetLength(CamWindows, MAX_PATH);
  if GetWindowsDirectory(PChar(CamWindows), MAX_PATH) > 0 then begin
     ArquivoServices := TStringList.Create;
     ArquivoServices.LoadFromFile( Trim(PChar(CamWindows)) +'\system32\drivers\etc\services' );
     if ArquivoServices.IndexOf('gds_db           3050/tcp') = -1 then
       ArquivoServices.Append('gds_db           3050/tcp');
     ArquivoServices.Free;
  end;
end;

procedure AlterarRegistroDoWindows;
var
  Registro : TRegistry;
  Valor : string;
begin
  Registro := TRegistry.Create;
  Registro.RootKey := HKEY_LOCAL_MACHINE;
  if Registro.OpenKey('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters',false) then begin
    Valor := Registro.ReadString('DataBasePath');
    Registro.DeleteValue('DataBasePath');
    Registro.WriteExpandString('DataBasePath',Valor);
  end;
  Registro.CloseKey;
  Registro.Free;
end;

procedure VerificarCaminhoDoBanco;
var
  SGEINI : TIniFile;
  Servidor, Caminho : string;
begin
  SGEINI := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'BANCO.ini');
  Servidor := SGEINI.ReadString('CONFBANCO','SERVIDOR','LOCALHOST');
  Caminho := SGEINI.ReadString('CONFBANCO','CAMINHO','C:\GESTOR\DADOS\GESTOR_DADOS.FDB');
        // Confirmando Servidor

      if InputQuery('Servidor','Informe o nome ou o ip do servidor de banco de dados',Servidor) then
        SGEINI.WriteString('CONFBANCO','SERVIDOR',Servidor);
      // Confirmando Caminho
      if InputQuery('Caminho','Informe o caminho do banco de dados',Caminho) then
        SGEINI.WriteString('CONFBANCO','CAMINHO',Caminho);

  frmConfig := TfrmConfig.Create(nil);
  frmConfig.ShowModal;
  frmConfig.Free;
  SGEINI.Free;
end;

function IsServerRunning: Boolean;
{ try to find the Firebird server window }
begin
  Result := (FindWindow(PChar(FBServerClass), nil) <> 0);
end;

function IsWinNT: Boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT);
//  Result := False; {*********}
end;

function IsServerRunningSvc : Boolean;
{ on Windows NT, read the service status }
begin
  if IsWinNT then
    Result := (GetServiceStatus(FBServerName) = ssRunning)
  else
    Result := False;
end;

function IsGuardRunning : Boolean;
{ try to find the Firebird guardian window }
begin
  Result := (FindWindow(PChar(FBGuardClass), nil) <> 0);
end;

function IsGuardRunningSvc : Boolean;
{ on Windows NT, read the service status }
begin
  if IsWinNT then
    Result := (GetServiceStatus(FBGuardianName) = ssRunning)
  else
    Result := False;
end;

procedure StopServer(Sender: TObject);

  procedure StopServer9x;
  var
    hGuardian : THandle;
    hServer   : THandle;
    t0        : Cardinal;
    Elapsed   : Cardinal;
  begin
    { Step 1: Shut down the guardian }
    hGuardian := FindWindow(PChar(FBGuardClass), nil);
    if hGuardian <> 0 then
    begin
      PostMessage(hGuardian, WM_CLOSE, 0, 0);

      { wait up to 10 seconds for guardian to shut down }
      t0 := GetTickCount;
      repeat
        Sleep(100); // 100 msec
        Elapsed := GetTickCount-t0;
      until (Elapsed > 10000) or not IsGuardRunning;
    end;

    { Step 2: Shut down the server }
    hServer := FindWindow(PChar(FBServerClass), nil);
    if hServer <> 0 then
    begin
      PostMessage(hServer, WM_CLOSE, 0, 0);

      { wait up to 10 seconds for server to shut down }
      t0 := GetTickCount;
      repeat
        Sleep(100); // 100 msec
        Elapsed := GetTickCount-t0;
      until (Elapsed > 10000) or not IsServerRunning;
    end;
  end;

  function StopDependentServices: Boolean;
  var
    ServiceList : TServiceList;
    i           : Integer;
  begin
    { query and stop dependent services }
    Result := True;
    ServiceList := TServiceList.Create;
    try
      { get list of running dependent services }
      GetDependentServices(FBServerName, True, ServiceList);
      if ServiceList.Count > 0 then
      begin
        if YesNoBox(
          Format(sAskStopDependentServices, [ServiceList.DisplayNames])
        ) = idYes
        then begin
          for i := 0 to ServiceList.Count-1 do begin
            DoStopService(ServiceList.Items[i].ServiceName);
          end;

          // query dependent services again
          ServiceList.Clear;
          GetDependentServices(FBServerName, True, ServiceList);

          // if ServiceList is empty, all dependent services have been stopped
          Result := (ServiceList.Count = 0);
        end                             { if YesNoBox() }
        else
          Result := False;
      end;                              { if DependentServices.Count > 0 }
    Finally
      ServiceList.Free;
    end;
  end; { StopDependentServices }

  procedure StopServerNT;
  var
    t0, Elapsed       : Cardinal;
  begin
    if not StopDependentServices then Exit;

    if (IsGuardRunning or IsGuardRunningSvc) then
    begin
      if IsGuardRunningSvc then
        DoStopService(FBGuardianName)
      else
        StopServer9x;

      { wait up to 20 seconds for guardian to shut down }
      Screen.Cursor := crHourGlass;
      t0 := GetTickCount;
      repeat
        Sleep(100); // 100 msec
        Elapsed := GetTickCount-t0;
      until (Elapsed > 21000) or (not (IsGuardRunning or IsGuardRunningSvc));
      Screen.Cursor := crDefault;
    end;

    if (IsServerRunning or IsServerRunningSvc) then
    begin
      if IsServerRunningSvc then
        DoStopService(FBServerName)
      else
        StopServer9x;

      { wait up to 20 seconds for server to shut down }
      Screen.Cursor := crHourGlass;
      t0 := GetTickCount;
      repeat
        Sleep(100); // 100 msec
        Elapsed := GetTickCount-t0;
      until (Elapsed > 21000) or (not (IsServerRunning or IsServerRunningSvc));
      Screen.Cursor := crDefault;
    end;
  end;

begin                                   { StopServer }
  if IsWinNT
  then StopServerNT
  else StopServer9x;
end;

procedure PararServico;
begin
  if (IsServerRunning) or (IsServerRunningSvc) then
  begin
    StopServer(nil);
  end;
end;

procedure SetAppAutostart(const Name, Cmd, Params : string; const Value: Boolean; AllUsers: Boolean);
{ add or remove autostart registry entry }
var
  Reg   : TRegistry;
  sHelp : string;
begin
  Reg := nil;
  Try
    Reg := TRegistry.Create;
    if AllUsers then
      Reg.RootKey := HKEY_LOCAL_MACHINE
    else
      Reg.RootKey := HKEY_CURRENT_USER;

    if Reg.OpenKey(FB_AutoRunKey, False) then
    begin
      { add or remove Autostart entry? }
      if Value then
      begin
        // do we need to put quotes around the command?
        if Pos(' ', Cmd) > 0
        then sHelp := AnsiQuotedStr(Cmd, #34)
        else sHelp := Cmd;

        if Length(Params) > 0
        then sHelp := sHelp + ' ' + Params;

        Reg.WriteString(Name, sHelp);
      end
      else begin
        Reg.DeleteValue(Name);
      end;
      Reg.CloseKey;
    end;
  Finally
    FreeAndNil(Reg);
  end;
end;                                    { SetAppAutostart }

procedure StartServer(Sender: TObject);

  procedure StartDependentServices;
  var
    ServiceList : TServiceList;
    i           : Integer;
  begin
    ServiceList := TServiceList.Create;
    try
      { get list of dependent, but stopped services }
      GetDependentServices(FBServerName, False, ServiceList);
      if (ServiceList.Count > 0)
      and (YesNoBox(Format(sAskStartDependentServices, [ServiceList.DisplayNames]))= idYes)
      then begin
        for i := 0 to ServiceList.Count-1 do begin
          DoStartService(ServiceList.Items[i].ServiceName);
        end;
      end;
    finally
      ServiceList.Free;
    end;
  end; { StartDependentServices }

  procedure StartServer9x;
  var
    Cmd     : String;
    ResCode : Integer;
    t0      : Cardinal;
    Elapsed : Cardinal;
  begin
    // Windows 9x: Start Server as application
    if (GuardFound and FUseGuardian) then
      Cmd := FBGuardExe
    else
      Cmd := FBServerExe;

    ResCode := ShellExecute(0, nil, PChar(cmd), PChar('-a'), PChar(FBRootDir), SW_NORMAL);
    if ResCode <= 32 then
      ErrorBox(SysErrorMessage(GetLastError))
    else begin
      { wait up to 10 seconds for server/guardian to start up }
      t0 := GetTickCount;
      repeat
        Sleep(100); // 100 msec
        Elapsed := GetTickCount-t0;
      until (Elapsed > 10000) or IsServerRunning;
    end;
  end;                                  { StartServer9x }

  procedure StartServerNT;
  begin
    if FUseService then
    begin
      if (GuardFound and FUseGuardian) then
        DoStartService(FBGuardianName)
      else
        DoStartService(FBServerName);

      StartDependentServices;
    end
    else
      StartServer9x;
  end;                                  { StartServerNT }

begin                                   { StartServer }
  if IsWinNT
  then StartServerNT
  else StartServer9x;
end;                                    { StartServer }

function IsAdmin: Boolean;
begin
  if IsWinNT then
    Result := uService.IsAdministrator
  else
    Result := True; // for Windows 9x
end;

procedure ApplySettings(Sender : TObject;UseServico, UseFBGuardian, UseAutoStart : boolean);
  procedure SetGuardianOptions(Active : Boolean; Value : Integer);
  { for Interbase 6/Firebird 1 only }
  var
    Reg : TRegistry;
  begin
    Reg := nil;
    try
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey(IB_RegKey, False) then
      begin
        if Active then
          Reg.WriteString(IB_GuardianOptions, IntToStr(Value))
        else
          Reg.DeleteValue(IB_GuardianOptions);
        Reg.CloseKey;
      end;
    Finally
      FreeAndNil(Reg);
    end;
  end;

  procedure ApplySettings9x(UseFBGuardian, UseAutoStart : boolean);
  begin
    if UseFBGuardian then
      SetAppAutoStart(FB_AutoStartName, FBGuardExe, '-a', UseAutoStart)
    else
      SetAppAutoStart(FB_AutoStartName, FBServerExe, '-a', UseAutoStart);

    // For Interbase 6.0 / Firebird 1.0, set the guardian options
    if GetServerType = stFirebird1 then
      SetGuardianOptions(True, Ord(UseFBGuardian))
    else begin
//      SetGuardianOptions(False, 0);
    end;
  end; { ApplySettings9x }

  procedure ApplySettingsNT(UsaServico, UseFBGuardian , UseAutoStart: boolean);
  begin
    if UsaServico then
    begin
      { run server/guardian as service }
      SetAppAutoStart(FB_AutoStartName, '', '', False);       // disable application autostart

      // For Interbase 6.0 / Firebird 1.0, set the guardian options
      if GetServerType = stFirebird1 then
        SetGuardianOptions(True, Ord(UseFBGuardian))
      else begin
//        SetGuardianOptions(False, 0);
      end;

      if UseFBGuardian then
      begin
        // server start on demand
        DoChangeServiceConfig(FBServerName, True, False);
        // guardian start automatic
        DoChangeServiceConfig(FBGuardianName, True, UseAutoStart);
      end
      else begin
        // disable guardian
        DoChangeServiceConfig(FBGuardianName, False, False);
        DoChangeServiceConfig(FBServerName, True, UseAutoStart);
      end;
    end
    else begin
      { run server/guardian as application }
      DoChangeServiceConfig(FBServerName, False, False);  // disable server
      DoChangeServiceConfig(FBGuardianName, False, False); // disable guardian

      ApplySettings9x(UseFBGuardian,UseAutoStart);
    end;
  end; { ApplySettingsNT }

begin                                   { ApplySettings }
  if IsWinNT
  then ApplySettingsNT(UseServico,UseFBGuardian,UseAutoStart)
  else ApplySettings9x(UseFBGuardian,UseAutoStart);

  if (not (IsServerRunning or IsServerRunningSvc)) and (not IsGuardRunning) and (UseAutoStart)
  then begin
    if (Sender = nil) or (YesNoBox(sAskStartServer) = idYes)
    then StartServer(nil);
  end;
end;                                    { ApplySettings }


procedure IniciarServico(UseServico, UseFBGuardias,UseAutoStart:boolean);
begin
  if (not IsServerRunning) and (not IsServerRunningSvc) then
  begin
    ApplySettings(nil,UseServico, UseFBGuardias,UseAutoStart); // "nil" -> don't ask user
    if not (IsServerRunning or IsServerRunningSvc) then StartServer(nil);
  end;
end;

{----------------------------------------------------------------------}
{ some useful functions                                                }
{----------------------------------------------------------------------}

function GetFirebirdRootDir : string;
begin
  Result := '';
  with TRegistry.Create do
  begin
    RootKey := HKEY_LOCAL_MACHINE;

    { Try Firebird Key first }
    if OpenKeyReadOnly(FB_RegKey) then
    begin
      if ValueExists(FB_DefaultInstance) then Result := ReadString(FB_DefaultInstance);
      CloseKey;
    end;

    { Not Found? Use older Borland/Interbase Key }
    if Length(Result)=0 then
    begin
      if OpenKeyReadOnly(IB_RegKey) then
      begin
        if ValueExists(IB_RootDir) then Result := ReadString(IB_RootDir);
        CloseKey;
      end;
    end;
    Free;
  end;
end;                                    { GetFirebirdRootDir }

function GetFileVersion(const ExeFileName: String) : string;
var
  VerInfo : TFileVersionData;
begin
  Result := '';
  { Try to read version information from exe file }
  VerInfo := TFileVersionData.Create(nil);
  try
    VerInfo.WorkFileName := ExeFileName;
    Result := VerInfo.FileDescription+' '+VerInfo.FileVersion;
  Finally
    VerInfo.Free;
  end;
end;                                    { GetFileVersion }


function GetFirebirdVersion : string;
var
  VerInfo : TFileVersionData;
begin
  Result := '';
  { Try to read version information from exe file }
  VerInfo := TFileVersionData.Create(nil);
  try
    VerInfo.WorkFileName := FBServerExe;
    Result := VerInfo.ProductVersion;
  Finally
    VerInfo.Free;
  end;
end;                                    { GetFirebirdVersion }



initialization

  { retrieve Firebird registry entries }
  FBRootDir := GetFirebirdRootDir;
  FBBinDir := IncludeTrailingBackslash(FBRootDir) + 'bin';
  if Length(FBRootDir)=0 then
  begin
    ErrorBox(sRegistryEntryMissing);
    PostQuitMessage(1);
  end;

  if Length(FBRootDir) = 0 then
  begin
    ErrorBox(sRegistryEntryMissing);
    PostQuitMessage(1);
  end;

  if not DirectoryExists(FBRootDir) then
  begin
    ErrorBox(sDirNotFound+FBRootDir);
    PostQuitMessage(1);
  end;

  { try to detect firebird 1.5 first }
  SetServerType(stFirebird15);

  { check server exe file name }
  FBServerExe := IncludeTrailingBackslash(FBBinDir)+GetName(ServerExe);
  ServerFound := FileExists(FBServerExe);

  if not ServerFound then
  begin
    { fallback to firebird 1.0 }
    SetServerType(stFirebird1);
    FBServerExe := IncludeTrailingBackslash(FBBinDir)+GetName(ServerExe);
    ServerFound := FileExists(FBServerExe);
  end;

  if not ServerFound then
  begin
    SetServerType(stNone);
    ErrorBox(sFileNotFound+' '+Firebird1Names[ServerExe]+'/'+Firebird15Names[ServerExe]);
    PostQuitMessage(1);
  end;

  FBGuardExe := IncludeTrailingBackslash(FBBinDir)+GetName(GuardExe);
  FBGuardianName  := GetName(GuardianName);
  FBGuardClass    := GetName(GuardClass);
  FBServerName    := GetName(ServerName);
  FBServerClass   := GetName(ServerClass);

  // DoQueryServiceConfig is valid for WinNT only!
  if IsWinNT then
  begin
    SL := TServiceList.Create;
    try
     GetDependentServices(FBServerName, True, SL);
    Finally
      SL.Free;
    end;
    DoQueryServiceConfig(FBGuardianName, aName, bEnabled, bAutoStart, bRunning);
    GuardFound := FileExists(FBGuardExe) and (Length(aName) > 0);
  end
  else
    GuardFound := FileExists(FBGuardExe);

  FUseGuardian := GuardFound;

  FUseAutoStart := IsAdmin;
  FUseService   := IsAdmin;
  FUseGuardian  := IsAdmin;
end.
